ENVS 193 - CHOYA 3

Part 1

Libraries

library(ggplot2)
library(tibble)
library(scales)
library(ggthemes)
library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

EX 1

mpg <- ggplot2::mpg
mpg %>% ggplot(aes(cty, hwy, colour = manufacturer)) +
  geom_point(show.legend = FALSE, size = 4) + 
  geom_point(show.legend = FALSE, size = 1, colour = "#F19F19") + 
  theme_void() + 
  scale_color_brewer()

### EX 2

# Trying out the function
polar_art(42, 100, c('blue', 'green', 'orange'))

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

# altering the function
polar_art2 <- function(seed, n, palette) {
  
  # set the state of the random number generator
  set.seed(seed)
  
  # data frame containing random values for 
  # aesthetics we might want to use in the art
  dat <- tibble(
    x0 = runif(n),
    y0 = runif(n),
    x1 = x0 + runif(n, min = -.2, max = .2),
    y1 = y0 + runif(n, min = -.2, max = .2),
    shade = runif(n),
    size = runif(n)
  )
  
  # plot segments in various colours, using 
  # polar coordinates and a gradient palette
  dat |> 
    ggplot(aes(
      x = x0,
      y = y0,
      xend = x1,
      yend = y1,
      colour = shade,
      size = size
    )) +
    geom_segment(show.legend = FALSE) +
    #coord_polar() + remove polar
    scale_y_continuous(expand = c(0, 0)) +
    scale_x_continuous(expand = c(0, 0)) + 
    scale_colour_gradientn(colours = palette) + 
    scale_size(range = c(0, 10)) + 
    theme_void()
}

polar_art2(42, 100, c('blue', 'green', 'orange')) # confetti

The reason that you would name multiple files instead of using git version control is because each creation is a new piece of art. We aren’t working toward an answer but rather a goal of making something aesthetically pleasing. If we were to write over a single file we could lose our previous creations.

EX 3

show_col(sample_canva(3))

show_col(sample_canva(10))

# write my own palette generator
sample_named_colours <- function(n){
  sample(colours(distinct = TRUE), n)
}

polar_art(runif(1, 0, 150), runif(1, 10, 150), sample_named_colours(15))

# Break the palette
sample_canva <- function(seed = NULL) {
  if(!is.null(seed)) set.seed(seed)
  sample(unlist(ggthemes::canva_palettes), 1)[[1]]
}

show_col(sample_canva(3))

EX 4

dat <- sample_data(n = 1000, seed = 1) |>
  mutate(y1 = y0, size = size * 4)

polar_styled_plot(palette = sample_canva(52)) + 
  geom_segment(data = dat,
               lineend = "round", 
               colour = "#222222") + 
  geom_point(data = dat)

# write a new function

my_styled_plot <- function(data = NULL, palette) {
  ggplot(
    data = data,
    mapping = aes(
      x = x0,
      y = y0,
      xend = x1,
      yend = y1,
      fill = shade,
      alpha = size
    )) + 
    coord_polar(clip = "off") +
    scale_y_continuous(
      expand = c(0, 0),
      limits = c(0, 1), 
      oob = scales::oob_keep
    ) +
    scale_x_continuous(
      expand = c(0, 0), 
      limits = c(0, 1), 
      oob = scales::oob_keep
    ) + 
    scale_fill_gradientn(colours = palette) + 
    scale_alpha(range = c(0.2, 1)) + 
    theme_void() + 
    guides(
      fill = guide_none(),
      alpha = guide_none(),
      colour = guide_none(),
      size = guide_none()
    )
}

my_styled_plot(palette = sample_canva(7)) + 
  geom_point(data = dat)

Part 2

library(dplyr)
library(purrr)

## 
## Attaching package: 'purrr'

## The following object is masked from 'package:scales':
## 
##     discard

library(tibble)
library(ggplot2)
library(ggthemes)
library(ambient)

EX 1

x_coords <- seq(from = 0, to = 1, length.out = 800)
y_coords <- seq(from = 0, to = 1, length.out = 800)
canvas <- long_grid(x = x_coords, y = y_coords) 

freq_spatial <- 10
seed_spatial <- 56
seed_palette <- 121

dat <- canvas |> 
  mutate(
    paint = gen_perlin(
      x = x, 
      y = y, 
      frequency = freq_spatial, 
      seed = seed_spatial
    )
  )
  
pic <- dat |>
  ggplot(aes(x, y, fill = paint)) + 
  geom_raster(show.legend = FALSE) +
  theme_void() + 
  coord_equal() +
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0)) +
  scale_fill_gradientn(
    colours = sample_canva(seed_palette)
  )

plot(pic)

EX 2

# call make noise art
make_noise_art(
  generator = gen_worley,
  seed = runif(1,50,1000), 
  palette = sample_canva(100),
  value = "distance",
  pixels = 1000
)

Nice art!

To create a nice file name I would first set a variable for each differing input. I would then include this var as a string in the filename = here() section. this would allow me to create a file name with a specialized name.

EX 3

gen_gate <- function(x, y, frequency, ...) {
  lf <- gen_simplex(x, y, frequency = frequency, ...)
  mf <- gen_simplex(x, y, frequency = frequency * 20, ...)
  hf <- gen_simplex(x, y, frequency = frequency * 99, ...)
  gate <- gen_simplex(x, y, frequency = frequency * 10, ...) 
  gate <- normalise(gate)
  paint <- lf + 
    (mf + 2) * (gate >= .2 & gate < .8) + 
    (hf + 2) * (gate >= .1)
  return(paint)
}

pal <- sample_canva(seed = 99)

fractal_art(billow, gen_worley, palette = pal, seed = 42, octaves = 19)

fractal_art(billow, gen_worley, palette = pal, seed = 1, octaves = 1) # ewwww

Wow that is ugly

# my own function

gen_custom <- function(x, y, frequency, ...) {
  simplex1 <- gen_simplex(x, y, frequency = frequency, ...)
  simplex2 <- gen_simplex(x, y, frequency = frequency * 2, ...)
  perlin <- gen_perlin(x, y, frequency = frequency * 0.5, ...)
  
  custom_gen <- (simplex1 + simplex2) * perlin
  return(normalise(custom_gen))
}

fractal_art(billow, gen_custom, palette = pal, seed = 1, octaves = 1)

EX 4

The time taken for curl-art-1 is 1.56seconds and the time taken for curl-art-2 is 3.74 seconds.

pic1

pic2

smol_grid <- long_grid(x = 1:20, y = 1:20)

pic1 <- smol_grid |>
  mutate(x = normalise(x), y = normalise(y)) |>
  curl_art(noise = gen_simplex, fractal = fbm, octaves = 19, freq_init = .7)
pic1

Part 3

library(dplyr)
library(tibble)
library(ggplot2)
library(ggforce)
library(deldir)

## deldir 1.0-9      Nickname: "Partial Distinction"

## 
##      The syntax of deldir() has changed since version 
##      0.0-10.  In particular the "dummy points" facility 
##      (which was a historical artifact) has been removed. 
##      In the current version, 1.0-8, an argument "id" has 
##      been added to deldir().  This new argument permits the 
##      user to specifier identifiers for points.  The default 
##      behaviour is to continue using the indices of the 
##      points to identify them.  In view of the fact that 
##      point identifiers may be user-supplied, the arguement 
##      "number", in plot.deldir() and plot.tile.list(), has 
##      had its name changed to "labelPts", and the argument 
##      "nex" in plot.deldir() has had its name changed to 
##      "lex".  In addition the name of the forth component 
##      of the "cmpnt_col" argument in plot.deldir() has been 
##      changed from "num" to "labels".  There is a new 
##      function getNbrs(), and the function tileInfo() has 
##      been modified to include output from getNbrs(). 
##      Please consult the help.

library(ggthemes)
library(voronoise)
library(tictoc)
library(ambient)
library(purrr)
library(tidyr)
library(stringr)

EX 1

sample_canva2 <- function(seed = NULL, n = 4) {
  if(!is.null(seed)) set.seed(seed)
  sample(ggthemes::canva_palettes, 1)[[1]] |>
    (\(x) colorRampPalette(x)(n))()  
}

choose_rectangle <- function(blocks) {
  sample(nrow(blocks), 1, prob = blocks$area)
}

choose_break <- function(lower, upper) {
  round((upper - lower) * runif(1))
}

create_rectangles <- function(left, right, bottom, top, value) {
  tibble(
    left = left,
    right = right,
    bottom = bottom,
    top = top,
    width = right - left,
    height = top - bottom,
    area = width * height,
    value = value
  )
}

split_rectangle_x <- function(rectangle, new_value) {
  with(rectangle, {
    split <- choose_break(left, right)
    new_left  <- c(left, left + split)
    new_right <- c(left + split, right)
    new_value <- c(value, new_value)
    create_rectangles(new_left, new_right, bottom, top, new_value)
  })
}

split_rectangle_y <- function(rectangle, new_value) {
  with(rectangle, {
    split <- choose_break(bottom, top)
    new_bottom <- c(bottom, bottom + split)
    new_top <- c(bottom + split, top)
    new_value <- c(value, new_value)
    create_rectangles(left, right, new_bottom, new_top, new_value)
  })
}

split_rectangle <- function(rectangle, value) {
  if(runif(1) < .5) {
    return(split_rectangle_x(rectangle, value))
  }
  split_rectangle_y(rectangle, value)
}

split_block <- function(blocks, value) {
  old <- choose_rectangle(blocks) 
  new <- split_rectangle(blocks[old, ], value)
  bind_rows(blocks[-old, ], new)
}

subdivision <- function(ncol = 1000, 
                        nrow = 1000, 
                        nsplits = 50, 
                        seed = NULL) {
  
  if(!is.null(seed)) set.seed(seed)
  blocks <- create_rectangles(
    left = 1, 
    right = ncol, 
    bottom = 1, 
    top = nrow, 
    value = 0
  )
  reduce(1:nsplits, split_block, .init = blocks)
}

develop <- function(div, seed = NULL) {
  
  div |> 
    ggplot(aes(
      xmin = left, 
      xmax = right, 
      ymin = bottom, 
      ymax = top,
      fill = value
    )) +
    geom_rect(
      colour = "#F19918", # I changed this background color
      size = 3,
      show.legend = FALSE
    ) +
    scale_fill_gradientn(
      colours = sample_canva2(seed)
    ) +
    coord_equal() +
    theme_void()
}

pic <- subdivision(seed = 10) |> develop() # I changed this line
plot(pic)

EX 2

sample_canva2 <- function(seed = NULL, n = 4) {
  if(!is.null(seed)) set.seed(seed)
  sample(ggthemes::canva_palettes, 1)[[1]] |>
    (\(x) colorRampPalette(x)(n))()  
}

choose_rectangle <- function(blocks) {
  sample(nrow(blocks), 1, prob = blocks$area)
}

choose_break <- function(lower, upper) {
  round((upper - lower) * runif(1))
}

create_rectangles <- function(left, right, bottom, top, value) {
  tibble(
    left = left,
    right = right,
    bottom = bottom,
    top = top,
    width = right - left,
    height = top - bottom,
    area = width * height,
    value = value
  )
}

split_rectangle_x <- function(rectangle, new_value) {
  with(rectangle, {
    split <- choose_break(left, right)
    new_left  <- c(left, left + split)
    new_right <- c(left + split, right)
    new_value <- c(value, new_value)
    create_rectangles(new_left, new_right, bottom, top, new_value)
  })
}

split_rectangle_y <- function(rectangle, new_value) {
  with(rectangle, {
    split <- choose_break(bottom, top)
    new_bottom <- c(bottom, bottom + split)
    new_top <- c(bottom + split, top)
    new_value <- c(value, new_value)
    create_rectangles(left, right, new_bottom, new_top, new_value)
  })
}

split_rectangle <- function(rectangle, value) {
  if(runif(1) < .5) {
    return(split_rectangle_x(rectangle, value))
  }
  split_rectangle_y(rectangle, value)
}

split_block <- function(blocks, value) {
  old <- choose_rectangle(blocks) 
  new <- split_rectangle(blocks[old, ], value)
  bind_rows(blocks[-old, ], new)
}

subdivision <- function(ncol = 1000, 
                        nrow = 1000, 
                        nsplits = 50, 
                        seed = NULL) {
  
  if(!is.null(seed)) set.seed(seed)
  blocks <- create_rectangles(
    left = 1, 
    right = ncol, 
    bottom = 1, 
    top = nrow, 
    value = 0
  )
  reduce(1:nsplits, split_block, .init = blocks)
}

fill_rectangle <- function(left, right, bottom, top, width, 
                           height, area, value, nshades = 100) {
  
  set.seed(value)
  fractals <- list(billow, fbm, ridged)
  generators <- list(gen_simplex, gen_perlin, gen_worley)
  
  expand_grid(
    x = left:right, 
    y = bottom:top, 
  ) |>
    mutate(
      fill = 10 * value + fracture(
        x = x * sample(-3:3, 1),
        y = y * sample(-3:3, 1),
        noise = sample(generators, 1)[[1]],
        fractal = sample(fractals, 1)[[1]],
        octaves = sample(10, 1),
        frequency = sample(10, 1) / 20,
        value = "distance2"
      ) |>
        normalise(to = c(1, nshades)) |> 
        round()
    )
}

draw_mosaic <- function(dat, palette) {
  background <- sample(palette, 1)
  dat |>
    ggplot(aes(x, y, fill = fill)) +
    geom_tile(show.legend = FALSE, colour = background, size = .2) +
    scale_size_identity() +
    scale_colour_gradientn(colours = palette) +
    scale_fill_gradientn(colours = palette) +
    scale_x_continuous(expand = expansion(add = 5)) +
    scale_y_continuous(expand = expansion(add = 5)) +
    coord_equal() +
    theme_void() +
    theme(plot.background = element_rect(fill = background)) 
}

mosaica <- function(ncol = 60, 
                    nrow = 60, 
                    nsplits = 30, 
                    seed = NULL) {
  
  subdivision(ncol, nrow, nsplits, seed) |>
    pmap_dfr(fill_rectangle) |> 
    slice_sample(prop = .995) |>
    filter(!is.na(fill)) |>
    draw_mosaic(palette = sample_canva2(seed))
}

pic <- mosaica(ncol = 100, nrow = 100, nsplits = 200, seed = 42) # I changed this line
plot(pic)

EX 3

sample_canva2 <- function(seed = NULL, n = 4) {
  if(!is.null(seed)) set.seed(seed)
  sample(ggthemes::canva_palettes, 1)[[1]] |>
    (\(x) colorRampPalette(x)(n))()  
}

unboxy <- function(iterations, layers) {
  
  coeffs <- array(
    data = runif(9 * layers, min = -1, max = 1), 
    dim = c(3, 3, layers)
  )
  
  point0 <- matrix(
    data = runif(3, min = -1, max = 1), 
    nrow = 1,
    ncol = 3
  )
  
  funs <- list(
    function(point) point + (sum(point ^ 2)) ^ (1/3),
    function(point) sin(point),
    function(point) 2 * sin(point)
  )
  
  update <- function(point, t) {
    l <- sample(layers, 1)
    f <- sample(funs, 1)[[1]]
    z <- point[3]
    point[3] <- 1
    point <- f(point %*% coeffs[,,l])
    point[3] <- (point[3] + z)/2
    return(point)
  }
  
  points <- accumulate(1:iterations, update, .init = point0)
  points <- matrix(unlist(points), ncol = 3, byrow = TRUE)
  points <- as_tibble(as.data.frame(points)) 
  names(points) <- c("x", "y", "val")
  return(points)
}

set.seed(2)  # Change the seed to generate a different random pattern

dat <- unboxy(iterations = 800, layers = 4)  # Adjust the iterations and layers

pic <- ggplot(dat, aes(x, y, fill = val)) +
  theme_void() + 
  coord_equal(xlim = c(-2.5, 2.5), ylim = c(-2.5, 2.5)) + 
  scale_fill_gradientn(colours = sample_canva2()) + 
  scale_x_continuous(expand = c(0, 0)) +
  scale_y_continuous(expand = c(0, 0))

pic2 <- pic +
  geom_voronoi_tile(
    colour = "#FF0000",  # Change the tile color
    size = 0.2, 
    show.legend = FALSE
  )

plot(pic2)

EX 4

sample_canva2 <- function(seed = NULL, n = 4) {
  if(!is.null(seed)) set.seed(seed)
  sample(ggthemes::canva_palettes, 1)[[1]] |>
    (\(x) colorRampPalette(x)(n))()  
}

unboxy <- function(iterations, layers) {
  
  coeffs <- array(
    data = runif(9 * layers, min = -1, max = 1), 
    dim = c(3, 3, layers)
  )
  
  point0 <- matrix(
    data = runif(3, min = -1, max = 1), 
    nrow = 1,
    ncol = 3
  )
  
  funs <- list(
    function(point) point + (sum(point ^ 2)) ^ (1/3),
    function(point) sin(point),
    function(point) 2 * sin(point)
  )
  
  update <- function(point, t) {
    l <- sample(layers, 1)
    f <- sample(funs, 1)[[1]]
    z <- point[3]
    point[3] <- 1
    point <- f(point %*% coeffs[,,l])
    point[3] <- (point[3] + z)/2
    return(point)
  }
  
  points <- accumulate(1:iterations, update, .init = point0)
  points <- matrix(unlist(points), ncol = 3, byrow = TRUE)
  points <- as_tibble(as.data.frame(points)) 
  names(points) <- c("x", "y", "val")
  return(points)
}

sift <- function(data) {
  data <- data |>
    group_by(group) |>
    mutate(
      tilesize = (max(x) - min(x)) * (max(y) - min(y)),
      x = if_else(tilesize > .02, x, x + rnorm(1)/10), 
      y = if_else(tilesize > .02, y, y + rnorm(1)/10)
    ) |>
    ungroup()
  return(data)
}

shake <- function(data) {
  data |> 
    group_by(group) |>
    mutate(
      x = x + runif(1)/10, 
      y = y + runif(1)/10
    ) |>
    ungroup()
}

voronoi_baroque <- function(
    seed, 
    perturb, 
    max.radius = NULL, 
    radius = 0, 
    expand = 0,
    ...
) {
  
  set.seed(seed)
  
  blank <- ggplot(mapping = aes(x, y, fill = val)) +
    theme_void() + 
    coord_equal(xlim = c(-2.75, 2.75), ylim = c(-2.75, 2.75)) + 
    guides(fill = guide_none(), alpha = guide_none()) +
    scale_fill_gradientn(colours = sample_canva2(seed)) + 
    scale_alpha_identity() + 
    scale_x_continuous(expand = c(0, 0)) +
    scale_y_continuous(expand = c(0, 0))
  
  blank + 
    geom_voronoise(
      data = unboxy(iterations = 10000, layers = 5),
      perturb = perturb,
      max.radius = max.radius,
      radius = radius,
      expand = expand,
      ...,
      show.legend = FALSE
    )
}

pic <- voronoi_baroque(99, sift) # this is where the changes occur # i used the value of 99
# and am using sift instead of shake
plot(pic)

EX 5

#remotes::install_github("paezha/truchet")
library(truchet)

set.seed(456)  # change the seed
mosaic <- st_truchet_ms(
  tiles = c("+", "dl", "ane"),  # Change the tiles to create a different pattern
  p1 = 0.3,  # Adjust the probability of scale 1
  p2 = 0.4,  # Adjust the probability of scale 2
  p3 = 0.3,  # Adjust the probability of scale 3
  xlim = c(1, 6),
  ylim = c(1, 6)
)

pic <- mosaic |> 
  ggplot(aes(fill = color)) +
  geom_sf(color = NA, show.legend = FALSE) + 
  scale_fill_gradientn(colours = c("#FF00A0", "#10AF00")) +  # Change the gradient colors
  theme_void()

plot(pic)

This looks really weird!

Part 4

Here is an output combining Truchet and some visual

library(truchet)
# step 1
set.seed(456)  # change the seed
mosaic <- st_truchet_ms(
  tiles = c("+", "dl", "ane"),  # Change the tiles to create a different pattern
  p1 = 0.3,  # Adjust the probability of scale 1
  p2 = 0.4,  # Adjust the probability of scale 2
  p3 = 0.3,  # Adjust the probability of scale 3
  xlim = c(1, 6),
  ylim = c(1, 6)
)

pic <- mosaic |> 
  ggplot(aes(fill = 1)) +
  geom_sf(color = NA, show.legend = FALSE) + 
  scale_fill_gradientn(colours = c("#FF00A0", "#10AF00")) +  # Change the gradient colors
  theme_void()

# step 2 
combine_methods <- function(seed, n, palette) {
  set.seed(seed)
  
  mosaic <- st_truchet_ms(
    tiles = c("+", "dl", "ane"),
    p1 = 0.3,
    p2 = 0.4,
    p3 = 0.3,
    xlim = c(1, 6),
    ylim = c(1, 6)
  )
  
  pic <- mosaic |> 
    ggplot(aes(fill = 1)) +
    geom_sf(color = NA, show.legend = FALSE) + 
    scale_fill_gradientn(colours = c("#FF00A0", "#10AF00")) +
    theme_void()
  
  dat <- tibble(
    x0 = runif(n),
    y0 = runif(n),
    x1 = x0 + runif(n, min = -.2, max = .2),
    y1 = y0 + runif(n, min = -.2, max = .2),
    shade = runif(n), 
    size = runif(n)
  )
  
  pic +
    geom_segment(data = dat, aes(x = x0, y = y0, xend = x1,
                                 yend = y1, colour = shade,
                                 size = size), show.legend = FALSE) +
    coord_polar() +
    scale_y_continuous(expand = c(0, 0)) +
    scale_x_continuous(expand = c(0, 0)) + 
    scale_colour_gradientn(colours = palette) + 
    scale_size(range = c(0, 10))
}

# step 3

combined_figure <- combine_methods(123, 200, c('blue', 'green', 'orange'))

#combined_figure

I keep running into this error so I will hault my trying.

Summary

I learned a lot in this choya, for example I had never even thought to take a set of data like the mpg and use that to make data that is pretty. Usually when I think of visualizing data, I imagine some plots that show trends or clustering. This exercise showed me a new way of thinking about data visualization and I find it really interesting. I learned that I was not able to create an image that mixed items from task 1 and task 2 together. I was familiar with ggplot and dplyr for data manipulation but that is about it. There were a lot of new concepts that were covered in this assignment.